(library (command-line)
  (export parse-arguments)
  (import (rnrs base)
          (only (guile)
                lambda* λ
                ;; command line args
                program-arguments
                ;; output
                simple-format
                current-output-port
                ;; file system
                call-with-input-file
                stat:type
                stat
                file-exists?
                ;; other
                quit)
          (json)
          ;; SRFIs
          ;; union and other set operations
          (srfi srfi-1)
          ;; structs
          (srfi srfi-9)
          ;; for functional structs (not part of srfi-9 directly)
          (srfi srfi-9 gnu)
          ;; hash table procedures
          (srfi srfi-69)
          ;; string procedures
          (srfi srfi-13)
          ;; command line arguments
          (srfi srfi-37)
          ;;(ice-9 hash-table)
          (ice-9 exceptions)))


;; store the options globally
(define options (make-hash-table))


;; make a procedure that only displays message and then exits
(define display-and-exit-proc
  (λ (msg)
    ;; needs to take the mandatory arguments though
    (lambda (opt name arg loads)
      ;; now only display
      (simple-format (current-output-port) "~a\n" msg)
      ;; and then quit the program
      (quit))))


(define make-store-in-options-proc
  (lambda* (#:optional (key #f))
    "Make a processor, which stores the option in the
options hash table, optionally taking a KEY under which to
store the value."
    (lambda (opt name arg loads)
      ;; (simple-format (current-output-port)
      ;;                "storing the following option and value: ~a, ~a\n"
      ;;                (if key key name)
      ;;                arg)
      (hash-table-set! options (if key key name) arg)
      ;; "and the processor should return seeds as well."
      loads)))


(define usage-help
  (string-join '(""
                 "main.scm [options]"
                 "-v FILE,  --vocabulary=FILE    specify vocabulary file"
                 ;; "-p,  --plot          specify progress plotting file"
                 "-h,  --help          display this help"
                 "")
               "\n"))


(define is-regular-file?
  (λ (file-path)
    ;; https://www.gnu.org/software/guile/manual/html_node/File-System.html
    (let ([stat-res (stat file-path #f)])
      (and stat-res
           (eq? (stat:type stat-res) 'regular)))))


(define option-spec
  ;; args-fold calls the processors of the options with the following arguments:
  ;; - the containing option object,
  ;; - the name used on the command line,
  ;; - the argument given for the option (or #f if none)
  ;; - the rest of the arguments are args-fold “seeds”
  ;;   and the processor should return seeds as well.
  ;; specify the options in a list of option objects
  (list (option '(#\v "vocabulary")  ; short name and long name
                #f  ; required-arg? - option must be followed by an argument
                #t  ; optional-arg? - option takes an argument if available
                ;; processor of option
                (λ (opt name arg loads)
                  ;; (simple-format (current-output-port) "opt: ~a\n" opt)
                  ;; (simple-format (current-output-port) "name: ~a\n" name)
                  ;; (simple-format (current-output-port) "arg: ~a\n" arg)
                  ;; (simple-format (current-output-port) "loads: ~a\n" loads)

                  (cond
                   [(not (string? arg))
                    (raise-exception
                     (make-exception (make-non-continuable-error)
                                     (make-exception-with-message "vocabulary argument needs value")
                                     (make-exception-with-irritants arg)
                                     (make-exception-with-origin 'option-spec)))]

                   [(not (file-exists? arg))
                    (raise-exception
                     (make-exception (make-non-continuable-error)
                                     (make-exception-with-message "file does not exist")
                                     (make-exception-with-irritants arg)
                                     (make-exception-with-origin 'option-spec)))]

                   [(not (is-regular-file? arg))
                    (raise-exception
                     (make-exception (make-non-continuable-error)
                                     (make-exception-with-message "file is not a regular file")
                                     (make-exception-with-irritants arg)
                                     (make-exception-with-origin 'option-spec)))]

                   [else
                    ((make-store-in-options-proc "vocabulary") opt name arg loads)])))

        #;(option '(#\p "plot") #t #f
                (λ (opt name arg loads)
                  (cond
                   [(not (file-exists? arg))
                    (raise-exception
                     (make-exception (make-non-continuable-error)
                                     (make-exception-with-message "plot file does not exist")
                                     (make-exception-with-irritants arg)
                                     (make-exception-with-origin 'command-line)))]
                   [(not (is-regular-file? arg))
                    (raise-exception
                     (make-exception (make-non-continuable-error)
                                     (make-exception-with-message "plot file is not a regular file")
                                     (make-exception-with-irritants arg)
                                     (make-exception-with-origin 'command-line)))]
                   [else
                    ((make-store-in-options-proc "plot") opt name arg loads)])))

        (option '(#\h "help") #f #f
                (display-and-exit-proc usage-help))))


(define parse-arguments
  (λ (prog-args)
    "no doc string yet"
    (args-fold
     ;; (program-arguments) simply contains all arguments to the guile command
     ;; We do not need the filename of the program, so we discard it and only use the cdr.
     (cdr prog-args)
     ;; use previously defined option specification
     option-spec
     ;; What happens when unknown arguments are given?
     ;; Unknown argument handling procedure.
     (λ (opt name arg loads)
       (raise-exception (make-exception (make-non-continuable-error)
                                        (make-exception-with-message "unrecognized option")
                                        (make-exception-with-irritants name)
                                        (make-exception-with-origin 'command-line))))
     ;; Call operand-proc with any items on the command line that are not named options.
     ;; This includes arguments after ‘--’.
     ;; It is called with the argument in question, as well as the seeds.
     (λ (op loads)
       (cons op loads))
     ;; seed - What is the seed???
     '())
    ;; return the globally defined options hash table
    options))
